Fritz: All Fritz/All Fritz.zip/All Fritz/FILES/PROGMISC/MODULA2.LZH/KERNEL.MOD

Text File | 1987-10-18 | 8KB | 303 lines

IMPLEMENTATION MODULE Kernel;
(* $S-, $R-, $T- *)

(* (C) Copyright 1987 Fitted Software Tools. All rights reserved.

    This module is part of the example multitasking communications program
    provided with the Fitted Software Tools' Modula-2 development system.

    Registered users may use this program as is, or they may modify it to
    suit their needs or as an exercise.

    If you develop interesting derivatives of this program and would like
    to share it with others, we encourage you to upload a copy to our BBS.
*)


IMPORT SYSTEM, Storage;
FROM SYSTEM     IMPORT ASSEMBLER, ADDRESS, NEWPROCESS;
FROM System     IMPORT TermProcedure, GetVector, SetVector, ResetVector;
FROM Storage    IMPORT ALLOCATE;

TYPE
    Process = POINTER TO ProcessDescriptor;
    ProcessDescriptor = RECORD
        proc    :ADDRESS;
        iop     :BOOLEAN;
        next    :Process;
    END;

    SignalHeader = POINTER TO SignalRec;
    SignalRec = RECORD
        count   :CARDINAL;
        list    :Process;
    END;

    LockHeader = POINTER TO LockRec;
    LockRec = RECORD
        count   :CARDINAL;
        owner   :Process;
        list    :Process;
    END;

VAR
    cp      :Process;           (* executing process - head of ready list *)


PROCEDURE NewProcess( p :PROC; n :CARDINAL; iop :BOOLEAN );
(*
    This procedure must be run at the "no priority" level because
    of the way NEWPROCESS is implemented (please refer to the
    documentation, under SYSTEM).
*)
VAR t  :Process;
    a  :ADDRESS;
BEGIN
    (* allocate the stack for the new process *)
    ALLOCATE( a, n );
    (* the new process is placed 2nd in ready list *)
    NEW( t );                           (* new process *)
    NEWPROCESS( p, a, n, t^.proc );     (* created *)
    t^.iop := iop;
    t^.next := cp^.next;                (* 2nd in list *)
    cp^.next := t;
END NewProcess;


PROCEDURE InitSignal( VAR s :SignalHeader );
BEGIN
    NEW( s );
    s^.count := 0; s^.list := NIL;
END InitSignal;


PROCEDURE InitLock( VAR l :LockHeader );
BEGIN
    NEW( l );
    l^.count := 0; l^.list := NIL;
END InitLock;


MODULE TheKernel[0];  (* the kernel runs with all interrupts disabled *)

    IMPORT Process, SignalHeader, LockHeader, cp;
    FROM SYSTEM     IMPORT ADDRESS, TRANSFER, IOTRANSFER;
    FROM Storage    IMPORT ALLOCATE;

    EXPORT Signal, Wait, WaitIO, Lock, Unlock;

    PROCEDURE Signal( VAR s :SignalHeader );
    VAR t, t0, t1 :Process;
    BEGIN
        WITH s^ DO
            IF list <> NIL THEN
                (* process(es) waiting for signal *)
                (* get the first out of waiting list *)
                t := list;
                list := list^.next;

                (* and put it into the ready list *)
                (* after cp and any iop *)
                t0 := cp;
                t1 := cp^.next;
                WHILE t1^.iop DO t0 := t1; t1 := t1^.next END;
                t^.next := t1;
                t0^.next := t;
            ELSE
                INC( count );
            END;
        END;
    END Signal;


    PROCEDURE Wait( VAR s :SignalHeader );
    VAR t0, t1 :Process;
    BEGIN
        WITH s^ DO
            IF count = 0 THEN
                (* sorry, must wait... *)
                t0 := cp;
                cp := cp^.next;     (* grab next to activate *)
                t0^.next := NIL;    (* t0 goes to end of wait list *)
                IF list = NIL THEN
                    list := t0;
                ELSE
                    t1 := list;
                    WHILE t1^.next <> NIL DO
                        t1 := t1^.next;
                    END;
                    t1^.next := t0;
                END;
                TRANSFER( t0^.proc, cp^.proc );
            ELSE
                (* just keep on going... *)
                DEC( count );
            END;
        END;
    END Wait;


    PROCEDURE Lock( VAR l :LockHeader );
    VAR t0, t1 :Process;
    BEGIN
        WITH l^ DO
            IF count = 0 THEN
                INC( count ); owner := cp;
            ELSIF owner = cp THEN
                (* we do not count locks here! *)
            ELSE
                (* sorry, must wait... *)
                t0 := cp;
                cp := cp^.next;     (* grab next to activate *)
                t0^.next := NIL;    (* t0 goes to end of wait list *)
                IF list = NIL THEN
                    list := t0;
                ELSE
                    t1 := list;
                    WHILE t1^.next <> NIL DO
                        t1 := t1^.next;
                    END;
                    t1^.next := t0;
                END;
                TRANSFER( t0^.proc, cp^.proc );
            END;
        END;
    END Lock;


    PROCEDURE Unlock( VAR l :LockHeader );
    VAR t, t0, t1 :Process;
    BEGIN
        WITH l^ DO
            IF (owner = cp) & (count > 0) THEN DEC( count ) END;
            IF count = 0 THEN
                IF list <> NIL THEN
                    (* process(es) waiting for lock *)
                    (* get the first out of waiting list *)
                    t := list;
                    list := list^.next;

                    (* give it the lock *)
                    INC( count );
                    owner := t;

                    (* and put it into the ready list *)
                    (* after cp and any iop *)
                    t0 := cp;
                    t1 := cp^.next;
                    WHILE t1^.iop DO t0 := t1; t1 := t1^.next END;
                    t^.next := t1;
                    t0^.next := t;
                END;
            END;
        END;
    END Unlock;


    PROCEDURE WaitIO( v :CARDINAL );
    VAR t0  :Process;
        p   :ADDRESS;
    BEGIN
        t0 := cp;                               (* get us out of ready list *)
        cp := cp^.next;
        p := cp^.proc;

        IOTRANSFER( t0^.proc, p, v );    (* activate next process *)

        (* and resume here *)
        cp^.proc := p;                          (* save interrupted state *)
        t0^.next := cp;                         (* resume driver *)
        cp := t0;
    END WaitIO;

END TheKernel;


(*PROCESS*) PROCEDURE idle;                 (* the idle process *)
BEGIN
    LOOP END;
END idle;


PROCEDURE IgnoreInt;
BEGIN
    ASM
        PUSH    AX
        MOV     AL, 20H
        OUT     20H, AL
        POP     AX
        IRET
    END;
END IgnoreInt;

VAR OrgIntMask  :BITSET;
    OrgVectors  :ARRAY [0..7] OF RECORD
        saved   :BOOLEAN;
        IntAdrs :ADDRESS;
    END;
    i           :CARDINAL;

PROCEDURE restore;
BEGIN
    ASM
        MOV     AL, OrgIntMask
        OUT     21H, AL
    END;
    FOR i := 0 TO 7 DO
        WITH OrgVectors[i] DO
            IF saved THEN
                ResetVector( 8 + i, IntAdrs );
            END;
        END;
    END;
END restore;

BEGIN
    (* enable all the 8259 interrupts *)

    (* first, get the current (original) interrupt mask *)
    OrgIntMask := {};
    ASM
        IN      AL, 21H
        MOV     OrgIntMask, AL
    END;

    (* save the interrupt vector values for all the disabled interrupts *)
    FOR i := 0 TO 7 DO
        WITH OrgVectors[i] DO
            IF i IN OrgIntMask THEN
                GetVector( 8 + i, IntAdrs );
                saved := TRUE;
            ELSE
                saved := FALSE
            END;
        END;
    END;

    (* install our termination procedure *)
    TermProcedure( restore );

    (* install a dummy interrupt handler for all the originally
       disabled interrupts.
    *)
    FOR i := 0 TO 7 DO
        WITH OrgVectors[i] DO
            IF saved THEN
                SetVector( 8 + i, IgnoreInt );
            END;
        END;
    END;

    (* enable all the interrupts *)
    ASM
        MOV     AL, 0
        OUT     21H, AL
    END;


    (* start the kernel *)
    NEW( cp ); cp^.next := NIL;         (* main process *)
    NewProcess( idle, 400, FALSE );     (* idle process *)

END Kernel.